(*****************************************************************************
 * Delphi Plug-in Framework (DPF)
 * Copyright (C) 2006-2007 Tao Yuan
 *
 * The contents of this file are subject to the Mozilla Public License
 * Version 1.1 (the "License"); you may not use this file except in compliance
 * with the License. You may obtain a copy of the
 * License at http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
 * the specific language governing rights and limitations under the License.                                                               }
 *
 * The Initial Developer of the Original Code is Tao Yuan. Portions created by
 * Tao Yuan are Copyright (C) Tao Yuan (taoy.cn att gmail dott com)
 * All rights reserved.
 *****************************************************************************)
 
unit RDStandardObjectFactory;

interface

uses
  Contnrs,
  Rcl,
  RdClasses, RDPluginRegistry, RDObjectFactory, RDPluginManager, RDPathResolver,
  RDPluginLifecycleHandler;

type
  TStandardObjectFactory = class(TObjectFactory)
  private


  protected
    config: TExtendedProperties;
    procedure configure(configuration: TExtendedProperties); override;
    function createClassInstance(aClassName: string): TObject;
    function createLifecycleHandler: TPluginLifecycleHandler;
    function getImplClassName(aClass: TClass): string; overload;
    function getImplClassName(aClassName: string): string; overload;
  public
    constructor Create;
    destructor Destroy; override;
    function createManager(registry: IPluginRegistry; pathResolver: IPathResolver):
        TPluginManager; overload; override;
    function createPathResolver: IPathResolver; override;
    function createRegistry: IPluginRegistry; override;
  end;

implementation

uses
  SysUtils, Classes,
  RDStandardPluginManager,
  //for some implemente object
  RDPluginRegistryImpl, RDStandardPathResolver, RDStandardPluginLifecycleHandler;
//
//var
//  objects: TObjectList;

constructor TStandardObjectFactory.Create;
begin
  inherited;
//
end;

destructor TStandardObjectFactory.Destroy;
begin
//  objects.Free;
  inherited;
end;

procedure TStandardObjectFactory.configure(configuration: TExtendedProperties);
begin
  if configuration <> nil then
    config := configuration
  else
    config := TExtendedProperties.Create;
end;

function TStandardObjectFactory.createClassInstance(aClassName: string):
    TObject;
var
  objClass: TRdLogPersistentClass;
begin
  objClass := TRdLogPersistentClass(GetClass(aClassName));
  if objClass <> nil then
    Result := objClass.Create
  else
    raise Exception.Create('Class -' + aClassName + ' not found!');
end;

function TStandardObjectFactory.createLifecycleHandler: TPluginLifecycleHandler;
var
  className: string;
begin
  className := getImplClassName(TPluginLifecycleHandler);
  if (className ='') then
      className := 'TStandardPluginLifecycleHandler'; //$NON-NLS-1$
  
  try
      result := TPluginLifecycleHandler(createClassInstance(className));
  except
    on e: Exception do
    begin
      log.fatal('failed creating plug-in life cycle handler instance ' //$NON-NLS-1$
              + className);
      raise Exception.Create(
              'failed creating plug-in life cycle handler instance ' //$NON-NLS-1$
              + className);
    end;
  end;

  result.configure(config.getSubset(className + '.')); //$NON-NLS-1$
  log.debug('life cycle handler instance created - ' + result.ClassName); //$NON-NLS-1$
end;

function TStandardObjectFactory.createManager(registry: IPluginRegistry;
    pathResolver: IPathResolver): TPluginManager;
begin
  Result := TStandardPluginManager.Create(registry, pathResolver,
          createLifecycleHandler);
end;

function TStandardObjectFactory.createPathResolver: IPathResolver;
var
  className: string;
begin
  className := getImplClassName('PathResolver');
  if (className = '') then
      className := 'TStandardPathResolver'; //$NON-NLS-1$

  try
    Supports(createClassInstance(className), IPathResolver, Result)
  except
    log.fatal('failed creating path resolver instance ' //$NON-NLS-1$
            + className);
    raise Exception.Create('failed creating path resolver instance ' //$NON-NLS-1$
            + className);
  end;
  try
    Result.configure(config.getSubset(className + '.')); //$NON-NLS-1$
  except
    log.fatal('failed configuring path resolver instance ' //$NON-NLS-1$
            + result.toString);
//    throw new Error("failed configuring path resolver instance " //$NON-NLS-1$
//            + result, e); 
  end;
  log.debug('path resolver instance created - ' + result.toString); //$NON-NLS-1$
end;

function TStandardObjectFactory.createRegistry: IPluginRegistry;
var
  className: string;
  obj: TObject;
begin
  className := getImplClassName('PluginRegistry');
  if (className = '') then
      className := 'TPluginRegistryImpl'; //$NON-NLS-1$


  obj := createClassInstance(className);
  if obj <> nil then
    obj.GetInterface(IPluginRegistry, result);
  if Result = nil then
  begin
    log.fatal('failed creating registry instance ' //$NON-NLS-1$
            + className);
    raise Exception.Create('failed creating registry instance ' //$NON-NLS-1$
            + className);
  end;
  result.configure(config.getSubset(className + '.')); //$NON-NLS-1$
  log.debug('registry instance created - ' + obj.ClassName); //$NON-NLS-1$
//  objects.Add(obj);
end;

function TStandardObjectFactory.getImplClassName(aClass: TClass): string;
begin
  result := getImplClassName(aClass.ClassName);
end;

function TStandardObjectFactory.getImplClassName(aClassName: string): string;
begin
  result := config.getProperty(aClassName);
  log.debug('implementation class for ' + aClassName //$NON-NLS-1$
          + ' is ' + result); //$NON-NLS-1$end;
end;

initialization
  RegisterClass(TStandardObjectFactory);
 // objects := TObjectList.Create;

finalization
//  objects.Free;

end.
